home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / tm / gnus-charset.el.z / gnus-charset.el
Encoding:
Text File  |  1998-05-21  |  5.8 KB  |  174 lines
  1. ;;; gnus-charset.el --- MIME charset extension for Gnus
  2.  
  3. ;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
  4.  
  5. ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
  6. ;; Created: 1996/8/6
  7. ;; Version:
  8. ;;    $Id: gnus-charset.el,v 0.16 1997/03/10 11:33:16 morioka Exp $
  9. ;; Keywords: news, MIME, multimedia, multilingual, encoded-word
  10.  
  11. ;; This file is not part of GNU Emacs yet.
  12.  
  13. ;; This program is free software; you can redistribute it and/or
  14. ;; modify it under the terms of the GNU General Public License as
  15. ;; published by the Free Software Foundation; either version 2, or (at
  16. ;; your option) any later version.
  17.  
  18. ;; This program is distributed in the hope that it will be useful, but
  19. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21. ;; General Public License for more details.
  22.  
  23. ;; You should have received a copy of the GNU General Public License
  24. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26. ;; Boston, MA 02111-1307, USA.
  27.  
  28. ;;; Code:
  29.  
  30. (require 'gnus)
  31.  
  32. (defvar gnus-is-red-gnus-or-later
  33.   (or (featurep 'gnus-load)
  34.       (module-installed-p 'gnus-sum)
  35.       ))
  36.  
  37.  
  38. ;;; @ newsgroup default charset
  39. ;;;
  40.  
  41. (defvar gnus-newsgroup-default-charset-alist nil)
  42.  
  43. (defun gnus-set-newsgroup-default-charset (newsgroup charset)
  44.   "Set CHARSET for the NEWSGROUP as default MIME charset."
  45.   (let* ((ng-regexp (concat "^" (regexp-quote newsgroup) "\\($\\|\\.\\)"))
  46.      (pair (assoc ng-regexp gnus-newsgroup-default-charset-alist))
  47.      )
  48.     (if pair
  49.     (setcdr pair charset)
  50.       (setq gnus-newsgroup-default-charset-alist
  51.         (cons (cons ng-regexp charset)
  52.           gnus-newsgroup-default-charset-alist))
  53.       )))
  54.  
  55.  
  56. ;;; @ for mule (Multilingual support)
  57. ;;;
  58.  
  59. (cond
  60.  ((featurep 'mule)
  61.   (require 'emu)
  62.   (defvar nntp-open-binary-connection-function
  63.     (if gnus-is-red-gnus-or-later
  64.     ;; maybe Red Gnus
  65.     (if (boundp 'nntp-open-connection-function)
  66.         nntp-open-connection-function
  67.       'nntp-open-network-stream)
  68.       ;; maybe Gnus 5.[01] or Gnus 5.[23]
  69.       (if (boundp 'nntp-open-server-function)
  70.       nntp-open-server-function
  71.     'nntp-open-network-stream)
  72.       ))
  73.   (defun nntp-open-network-stream-with-no-code-conversion (&rest args)
  74.     (let ((proc (apply nntp-open-binary-connection-function args)))
  75.       (set-process-input-coding-system proc *noconv*)
  76.       proc))
  77.   (if gnus-is-red-gnus-or-later
  78.       (setq nntp-open-connection-function
  79.         'nntp-open-network-stream-with-no-code-conversion)
  80.     (setq nntp-open-server-function
  81.       'nntp-open-network-stream-with-no-code-conversion)
  82.     )
  83.   (call-after-loaded
  84.    'nnheader
  85.    (lambda ()
  86.      (defun nnheader-find-file-noselect (&rest args)
  87.        (as-binary-input-file
  88.         (let ((format-alist nil)
  89.               (auto-mode-alist (nnheader-auto-mode-alist))
  90.               (default-major-mode 'fundamental-mode)
  91.               (after-insert-file-functions ; for jam-code-guess
  92.                (if (memq 'jam-code-guess-after-insert-file-function
  93.                          after-insert-file-functions)
  94.                    '(jam-code-guess-after-insert-file-function))))
  95.           (apply 'find-file-noselect args)))
  96.        )
  97.      ;; Red Gnus 0.67 or later
  98.      (defun nnheader-insert-file-contents
  99.        (filename &optional visit beg end replace)
  100.        (as-binary-input-file
  101.         (let ((format-alist nil)
  102.               (auto-mode-alist (nnheader-auto-mode-alist))
  103.               (default-major-mode 'fundamental-mode)
  104.               (enable-local-variables nil)
  105.               (after-insert-file-functions ; for jam-code-guess
  106.                (if (memq 'jam-code-guess-after-insert-file-function
  107.                          after-insert-file-functions)
  108.                    '(jam-code-guess-after-insert-file-function))))
  109.           (insert-file-contents filename visit beg end replace))
  110.         )
  111.        ;; for gnspool on OS/2
  112.        (while (re-search-forward "\r$" nil t)
  113.      (replace-match "")
  114.      )
  115.        )
  116.      ;; imported from Red Gnus 0.66
  117.      (or (fboundp 'nnheader-auto-mode-alist)
  118.          (defun nnheader-auto-mode-alist ()
  119.            (let ((alist auto-mode-alist)
  120.                  out)
  121.              (while alist
  122.                (when (listp (cdar alist))
  123.                  (push (car alist) out))
  124.                (pop alist))
  125.              (nreverse out)))
  126.          )
  127.      ;; alias for Old Gnus
  128.      (defalias 'nnheader-insert-file-contents-literally
  129.        'nnheader-insert-file-contents)
  130.      ))
  131.   (call-after-loaded
  132.    'nnmail
  133.    (lambda ()
  134.      (defun nnmail-find-file (file)
  135.        "Insert FILE in server buffer safely. [gnus-charset.el]"
  136.        (set-buffer nntp-server-buffer)
  137.        (erase-buffer)
  138.        (let ((format-alist nil)
  139.              (after-insert-file-functions   ; for jam-code-guess
  140.               (if (memq 'jam-code-guess-after-insert-file-function
  141.                         after-insert-file-functions)
  142.                   '(jam-code-guess-after-insert-file-function)))
  143.          )
  144.      (as-binary-input-file
  145.       (condition-case ()
  146.           (progn (insert-file-contents file) t)
  147.         (file-error nil))
  148.       )))
  149.      ))
  150.   (defun gnus-prepare-save-mail-function ()
  151.     (setq file-coding-system *noconv*
  152.       buffer-file-coding-system 'no-conversion)
  153.     )
  154.   (add-hook 'nnmail-prepare-save-mail-hook
  155.         'gnus-prepare-save-mail-function)
  156.   
  157.   (gnus-set-newsgroup-default-charset "alt.chinese" 'hz-gb-2312)
  158.   (gnus-set-newsgroup-default-charset "alt.chinese.text.big5" 'cn-big5)
  159.   (gnus-set-newsgroup-default-charset "fj"    'iso-2022-jp-2)
  160.   (gnus-set-newsgroup-default-charset "han"        'euc-kr)
  161.   (gnus-set-newsgroup-default-charset "hk"    'cn-big5)
  162.   (gnus-set-newsgroup-default-charset "hkstar"    'cn-big5)
  163.   (gnus-set-newsgroup-default-charset "relcom"    'koi8-r)
  164.   (gnus-set-newsgroup-default-charset "tw"    'cn-big5)
  165.   ))
  166.  
  167.  
  168. ;;; @ end
  169. ;;;
  170.  
  171. (provide 'gnus-charset)
  172.  
  173. ;;; gnus-charset.el ends here
  174.